home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Libris Britannia 4
/
science library(b).zip
/
science library(b)
/
PROGRAMM
/
DB_CLIPP
/
0292.ZIP
/
MAILMEN.ARC
/
PRINTCAT.PRG
< prev
next >
Wrap
Text File
|
1985-12-21
|
6KB
|
228 lines
* Converted to Dbase III by Bill Simpson 6/7/85 (713) 530-8500
*!!* dBASE CONVERT - dBASE III File Conversion Aid v1.0 6/14/84
*
SET HEADING OFF
SET SAFETY OFF
SET TALK OFF
CLEAR
STORE .T. TO BEVEL
DO WHILE BEVEL
STORE ' ' TO ANS1
@ 10,5 say "Do you wish to print a list of friends or business (F or B) ?"
@ 10,75 GET ANS1
READ
CLEAR GETS
IF UPPER(ANS1) = 'F' .OR. UPPER(ANS1) = 'B'
STORE .F. TO BEVEL
ENDIF
ENDDO
IF UPPER(ANS1) = 'F'
USE MAIL
STORE .T. TO BLUE
DO WHILE BLUE
STORE ' ' TO INDEX1
CLEAR
@ 10,5 SAY "Do You Want to Reindex the File (Y OR N) ?"
@ 10,75 GET INDEX1
READ
CLEAR GETS
IF UPPER(INDEX1)= 'Y'
INDEX ON LAST TO LAST
STORE .F. TO BLUE
ELSE
IF UPPER(INDEX1) = 'N'
STORE .F. TO BLUE
ENDIF
ENDIF
ENDDO
STORE 60 TO N
CLEAR
STORE 0 TO INDEX2
USE MAIL INDEX LAST
GO TOP
SET PRINT ON
? CHR(15)
STORE .T. TO TRUE
DO WHILE TRUE
? 'NAME',' ','|', 'COMPANY', ' ';
,' ','|', 'OFFICE TEL. ','|', 'HOME TEL.'
? '====',' ','|', '=======', ' ';
,' ','|', '=========== ','|', '========='
DO WHILE .NOT. EOF() .AND. INDEX2 < N
IF FRIEND <> ' '
? LAST, FIRST,'|', COMPANY,'|', TEL_WRK,'|', TEL_HM
STORE INDEX2 +1 TO INDEX2
ENDIF
SKIP
ENDDO
IF INDEX2 >= N
EJECT
STORE 0 TO INDEX2
ENDIF
IF EOF() = .T.
STORE .F. TO TRUE
ENDIF
ENDDO
EJECT
? CHR(18)
SET PRINT OFF
RETURN
ENDIF
IF UPPER(ANS1) = 'B'
STORE .T. TO RIGHT
DO WHILE RIGHT
STORE ' ' TO P
CLEAR
@ 10,5 SAY "Press 'A' To Print All Categories"
@ 12,5 SAy "Press 'S' to print selected categories"
@ 12,70 get P
READ
CLEAR GETS
IF UPPER(P) = 'A' .OR. UPPER(P) = 'S'
STORE .F. TO RIGHT
ENDIF
ENDDO
IF UPPER(P) = 'A'
STORE 60 TO N
CLEAR
USE MAIL
STORE .T. TO BLUE
DO WHILE BLUE
STORE ' ' TO INDEX1
CLEAR
@ 10,5 SAY "Do You Want to Reindex the File (Y OR N) ?"
@ 10,75 GET INDEX1
READ
CLEAR GETS
IF UPPER(INDEX1) = 'Y'
INDEX ON COMPANY TO COMP
STORE .F. TO BLUE
ELSE
IF UPPER(INDEX1) = 'N'
STORE .F. TO BLUE
ENDIF
ENDIF
ENDDO
STORE 0 TO INDEX2
USE MAIL INDEX COMP
GO TOP
SET PRINT ON
? CHR(15)
STORE .T. TO TRUE
DO WHILE TRUE
? 'COMPANY',' ','|', 'NAME', ' ';
,' ','|','OFFICE TEL. ','|', 'HOME TEL.'
? '=======',' ','|', '====', ' ';
,' ','|','=========== ','|', '========='
DO WHILE .NOT. EOF() .AND. INDEX2 < N
IF FRIEND = ' '
? COMPANY,'|', FIRST, LAST,'|', TEL_WRK,'|', TEL_HM
STORE INDEX2 +1 TO INDEX2
ENDIF
SKIP
ENDDO
IF INDEX2 >= N
EJECT
STORE 0 TO INDEX2
ENDIF
IF EOF()
STORE .F. TO TRUE
ENDIF
ENDDO
EJECT
? CHR(18)
SET PRINT OFF
RETURN
ENDIF
IF UPPER(P) = 'S'
STORE .T. TO CONTINUE
DO WHILE CONTINUE
SET PRINT OFF
STORE .T. TO LEVEL
DO WHILE LEVEL
STORE ' ' TO ANS
STORE ' ' TO CAT
CLEAR
?
?
?
?
*!! There will be no automatic colon following this prompt string.
ACCEPT "What Priority Level Are You Searching (1,2, OR 3) ?" TO ANS
?
?
*!! There will be no automatic colon following this prompt string.
ACCEPT "What Category Are You Looking For ?" TO CAT
IF ANS = '1' .OR. ANS = '2' .OR. ANS = '3'
STORE 'PROF'-ANS TO PROF
STORE .F. TO LEVEL
ENDIF
ENDDO
CLEAR
STORE UPPER(CAT) TO CAT
USE MAIL
STORE .T. TO TRUE
DO WHILE TRUE
STORE ' ' TO INDEX
@ 10,5 SAY "Do You Want to Reindex the File (Y OR N) ?" GET INDEX
READ
IF UPPER(INDEX)= 'Y'
INDEX ON &PROF TO &PROF
STORE .F. TO TRUE
ELSE
IF UPPER(INDEX) = 'N'
STORE .F. TO TRUE
ENDIF
ENDIF
ENDDO
USE MAIL INDEX &PROF
*!! EOF() will be true if NO FIND, and RECNO() will equal BOTTOM, not 0.
FIND &CAT
STORE 60 TO N
CLEAR
STORE 0 TO INDEX
SET PRINT ON
? CHR(15)
STORE .T. TO TRUE
DO WHILE TRUE
? "&CAT"
? "------------------------------"
? 'COMPANY',' ','|', 'NAME', ' ';
,' ','|','OFFICE TEL. ','|', 'HOME TEL.'
? '=======',' ','|', '====', ' ';
,' ','|','=========== ','|', '========='
DO WHILE .NOT. EOF() .AND. &PROF = '&CAT' .AND. INDEX < N
? COMPANY,'|', FIRST, LAST,'|', TEL_WRK,'|', TEL_HM
STORE INDEX +1 TO INDEX
SKIP
ENDDO
IF INDEX >= N
EJECT
STORE 0 TO INDEX
ENDIF
IF EOF() = .T.
STORE .F. TO TRUE
ENDIF
IF &PROF <> '&CAT'
STORE .F. TO TRUE
ENDIF
ENDDO
CLEAR
STORE ' ' TO CONT
@ 10,5 SAY 'Do you wish to continue ?'
@ 12,5 SAY "Press 'N' to Return to the Menu"
@ 14,5 SAY 'Press any other key to continue'
@ 14,40 GET CONT
READ
CLEAR GETS
IF UPPER(CONT) = 'N'
EJECT
? CHR(18)
SET PRINT OFF
STORE .F. TO CONTINUE
RETURN
ELSE
ENDDO
ENDIF
ENDIF